home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / probta11.zip / PROBETA.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-03  |  9KB  |  364 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1992 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. {!!!IMPORTANT!!! F5 WON'T WORK WITHOUT THE FOLLOWING LINE}
  14. {$M 9000,18000,18000}  {Stack, minheap, maxheap}
  15. {$S-,R-}
  16. {$L+,D+}
  17. {$V-}
  18.  
  19. Program beta_door;
  20.  
  21. Uses
  22.    Dos,
  23.    MiniCrt,    {BIOS-only crt functions}
  24.    OpenShare,  {Shared text files}
  25.    MdosIO,     {Dos-level random access files}
  26.    BufIO,      {Buffered record i/o}
  27.    Tools,      {Various utilities}
  28.    ProBye,
  29.    ProData,    {ProDoor/pcboard data}
  30.    ProRoot,    {ProKit main support library}
  31.    ProSysf,    {ProKit Status display, function keys, system functions}
  32.    ProScan,    {File display and colorization}
  33.    ProUtil,    {ProKit utility library #1}
  34.    ProUtil2,   {proKit utility library #2}
  35.    KitInit;    {ProKit initialization/deinit}
  36.  
  37. const
  38.    door_version = 'Automatic Beta Distribution DOOR v1.1 (04-03-93)';
  39.    max_proto = 10;
  40.    max_file_count = 20;
  41.    protocol_count:  integer = 0;
  42.    file_count:  integer = 0;
  43.    logfile = 'PROBETA.LOG';
  44.  
  45. var
  46.    protocol_name: array[1..max_proto] of string[40];
  47.    protocol_cmd:  array[1..max_proto] of string[128];
  48.  
  49.    file_descr:    array[1..max_file_count] of string[255];
  50.    file_path:     array[1..max_file_count] of string[64];
  51.  
  52.    sel_prot:      byte;
  53.    sel_file:      byte;
  54.  
  55.    user_name:     anystring;
  56.    user_city:     anystring;
  57.  
  58.  
  59. (* ---------------------------------------------------------------- *)
  60. procedure load_config;
  61. var
  62.    fd:   text;
  63.    i:    integer;
  64.    temp: string;
  65.  
  66. begin
  67.    assignText(fd,config_file);
  68.    reset(fd);
  69.  
  70.    readln(fd);   {interrupt}
  71.  
  72.    readln(fd,protocol_count);
  73.    for i := 1 to protocol_count do
  74.    begin
  75.       readln(fd,protocol_name[i]);
  76.       readln(fd,protocol_cmd[i]);
  77.    end;
  78.  
  79.    readln(fd,file_count);
  80.    for i := 1 to file_count do
  81.    begin
  82.       readln(fd,file_descr[i]);
  83.       repeat
  84.          readln(fd,temp);
  85.          if temp[1]='|' then
  86.             file_descr[i] := file_descr[i] + temp;
  87.       until temp[1] <> '|';
  88.  
  89.       file_path[i] := temp;
  90.    end;
  91.  
  92.    close(fd);
  93. end;
  94.  
  95.  
  96.  
  97. (* ---------------------------------------------------------------- *)
  98. procedure logstr(s: string);
  99. var
  100.    fd:   text;
  101. begin
  102.    assign(fd,logfile);
  103.    {$i-} append(fd); {$i+}
  104.    if ioresult <> 0 then
  105.       rewrite(fd);
  106.  
  107.    write(fd,system_date,' ',system_time,' ');
  108.    if pcbsetup.under_network then
  109.       write(fd,'(',pcbsetup.node_number^,') ');
  110.    writeln(fd,s);
  111.  
  112.    close(fd);
  113. end;
  114.  
  115.  
  116. (* ---------------------------------------------------------------- *)
  117. function itoa2(i: integer): anystring;
  118. var
  119.    s: anystring;
  120. begin
  121.    str(i,s);
  122.    if length(s) = 1 then
  123.       s := '0' + s;
  124.    itoa2 := s;
  125. end;
  126.  
  127.  
  128. (* ---------------------------------------------------------------- *)
  129. procedure report_dszlog;
  130. var
  131.    tail:    anystring;
  132.    fd:      text;
  133.  
  134. begin
  135.    newline;
  136.  
  137.    if dos_exists(GetEnv('DSZLOG')) then
  138.    begin
  139.       assign(fd,GetEnv('DSZLOG'));
  140.       reset(fd);
  141.       while not eof(fd) do
  142.       begin
  143.          readln(fd,tail);
  144.          make_log_entry(tail,true);
  145.          logstr(tail);
  146.       end;
  147.       close(fd);
  148.       erase(fd);
  149.    end;
  150.  
  151. end;
  152.  
  153. (* ---------------------------------------------------------------- *)
  154. function execute(cmd: anystring): integer;
  155. var
  156.    exe:     anystring;
  157.    key:     anystring;
  158.    tail:    anystring;
  159.    i:       integer;
  160.  
  161.    function try(ext: anystring): boolean;
  162.    begin
  163.       exe := FSearch(key+ext,GetEnv('PATH'));
  164.       try := exe = '';
  165.    end;
  166.  
  167. begin
  168.    prepare_line(cmd);
  169.  
  170.    i := pos(' ',cmd);
  171.    key := copy(cmd,1,i-1);
  172.    tail := copy(cmd,i+1,255);
  173.  
  174.    if try('.com') then
  175.    if try('.exe') then
  176.    begin
  177.       tail := '/c '+tail;
  178.       exe := GetEnv('COMSPEC');
  179.    end;
  180.  
  181.    logstr(exe+' '+tail);
  182.    writeln('Command: ',exe,' ',tail);
  183.    writeln;
  184.  
  185.    dos_unlink(GetEnv('DSZLOG'));
  186.  
  187.    flush_com;
  188.    exec(exe,tail);
  189.    execute := DosExitCode;
  190.  
  191.    linenum := 1;
  192.    update_status_display(normal_format);
  193.    newline;
  194. end;
  195.  
  196. (* ---------------------------------------------------------------- *)
  197. procedure main;
  198. var
  199.    i,j:     integer;
  200.    DirInfo: SearchRec;
  201.    Date:    DateTime;
  202.    fnames:  anystring;
  203.    fpaths:  anystring;
  204.    temp:    string;
  205.  
  206. begin
  207.    display_file('PROBETA.TXT');
  208.  
  209.    repeat
  210.       pdisp('$YELLOW$Please enter your first AND last name: ');
  211.       user_name := '';
  212.       input(user_name,30);
  213.       newline;
  214.  
  215.       if dump_user then exit;
  216.       stoupper(user_name);
  217.    until (length(user_name) > 3) and (pos(' ',user_name) > 1);
  218.  
  219.    repeat
  220.       pdisp('$YELLOW$Please enter your city AND state or country: ');
  221.       user_city := '';
  222.       input(user_city,30);
  223.       newline;
  224.  
  225.       if dump_user then exit;
  226.       stoupper(user_city);
  227.    until (length(user_city) > 3) and (pos(',',user_city)+pos(' ',user_city) > 1);
  228.  
  229.    make_log_entry('User: ' + user_name + ' ('+user_city+')',false);
  230.    logstr(user_name + ' ('+user_city+')');
  231.  
  232.    set_node_info(node_in_door,user_name,user_city,'Running ProBeta');
  233.  
  234.    newline;
  235.    cmdline := '';
  236.    pdispln('$DEFAULT$Files available:');
  237.    newline;
  238.    displn(' #    File Name   Updated                   Description');
  239.    displn('---  ------------ -------- --------------------------------------------');
  240.  
  241.    for i := 1 to file_count do
  242.    begin
  243.       FindFirst(file_path[i],$21,DirInfo);
  244.       if DosError = 0 then
  245.       begin
  246.          file_path[i] := path_only(file_path[i])+'\'+DirInfo.name;
  247.          UnpackTime(DirInfo.Time, Date);
  248.  
  249.          disp( aGREEN+  rjust(itoa(i),2)+'   '+
  250.                aWHITE+  ljust(DirInfo.name,13)+
  251.                aRED+    itoa2(Date.Month)+'-'+
  252.                         itoa2(Date.Day)+'-'+
  253.                         itoa2(Date.Year-1900)+' '+
  254.                aWHITE);
  255.  
  256.          temp := file_descr[i];
  257.          repeat
  258.             j := pos('|',temp);
  259.             if j = 0 then
  260.                displn(temp)
  261.             else
  262.             begin
  263.                displn(copy(temp,1,j-1));
  264.                disp('                           '+aGRAY);
  265.                temp := copy(temp,j+1,255);
  266.             end;
  267.          until j = 0;
  268.       end;
  269.    end;
  270.  
  271.    newline;
  272.    fpaths := '';
  273.    fnames := '';
  274.    repeat
  275.       sel_file := 1;
  276.       get_int('Please select the file NUMBER(s) to download:',sel_file);
  277.       if dump_user or (sel_file < 1) or (sel_file > file_count) then exit;
  278.       fpaths := fpaths + ' ' + file_path[sel_file];
  279.       fnames := fnames + ' ' + remove_path(file_path[sel_file]);
  280.    until cmdline = '';
  281.    newline;
  282.  
  283.    if dump_user or (sel_file < 1) or (sel_file > file_count) then exit;
  284.  
  285.    repeat
  286.       cmdline := '';
  287.       displn('Protocols available:');
  288.       newline;
  289.       displn(' #                  Description');
  290.       displn('---  -----------------------------------------');
  291.  
  292.       for i := 1 to protocol_count do
  293.          displn(aGREEN+' '+itoa(i)+'     '+aWHITE+protocol_name[i]);
  294.  
  295.       newline;
  296.       sel_prot := 1;
  297.       get_int('Please select the protocol NUMBER you wish to use:',sel_prot);
  298.       newline;
  299.       if dump_user or (par = '0') then exit;
  300.  
  301.       if par <> '' then
  302.       begin
  303.          sel_prot := atoi(par);
  304.  
  305.          if sel_prot = 0 then
  306.             for i := 1 to protocol_count do
  307.                if upcase(par[1]) = upcase(protocol_name[i][1]) then
  308.                   sel_prot := i;
  309.       end;
  310.  
  311.    until (sel_prot > 0) and (sel_prot <= protocol_count);
  312.  
  313.    par2 := fnames;
  314.    par3 := protocol_name[sel_prot];
  315.    pdispln('$WHITE$Begin your download of$2$ using $3$ NOW ...');
  316.    newline;
  317.  
  318.    clrscr;
  319.    writeln('User: ',user_name,' (',user_city,')');
  320.  
  321.    {set_node_info(node_in_door,user_name,user_city,'Downloading'+fnames);}
  322.    i := execute(protocol_cmd[sel_prot] + ' ' + fpaths);
  323.  
  324.    newline;
  325.    if i = 0 then
  326.       pdispln('$GREEN$File transfer completed successfully.')
  327.    else
  328.       pdispln('$RED$File transfer ABORTED!');
  329.  
  330.    report_dszlog;
  331.    newline;
  332.  
  333.    if i = 0 then
  334.       make_log_entry('(D)'+fnames+' Completed using '+ protocol_name[sel_prot],true)
  335.    else
  336.       make_log_entry('(D)'+fnames+' Aborted using '+ protocol_name[sel_prot],true)
  337.  
  338.    end;
  339.  
  340. (* ---------------------------------------------------------------- *)
  341.  
  342. begin  {main block}
  343.    init;     {must be first - opens com port, loads setup and user data}
  344.    progname := 'ProBeta';        {program name on status line}
  345.  
  346.    if minutes_left < 5 then
  347.       adjust_time_allowed(5*60);  {give 5 free minutes for entering this door}
  348.  
  349.    {auto_detect_ansi;}
  350.  
  351.    load_config;
  352.  
  353.    newline;
  354.    pdispln('$YELLOW$'+door_version);
  355.    displn('Copyright 1992 Samuel H. Smith');
  356.    newline;
  357.  
  358.    main;
  359.  
  360.    uninit;   {must be last - closes com port and updates database}
  361. end.
  362.  
  363.  
  364.